#include <sys/types.h>
#include <stdarg.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>

#include "memenv.h"
#include "dobj.h"
#include "mvect.h"
#include "dobjauxlib.h"

struct cursor {
	uint32_t	csr_off;
	uint32_t	csr_line;
	const	char*	csr_pos;
	const	char*	csr_end;
};

#define	MOVE_CURSOR(csr, n)				do {		\
	(csr)->csr_pos += n;						\
	(csr)->csr_off += n;						\
} while (0)

#define	ISSPACE(c)	(((c) == ' ') || ((c) == '\t') || ((c) == '\r'))
#define	ISNEWLINE(c)	((c) == '\n')

#define	SKIP_WHILE(ch, csr, check)			do {		\
	(ch) = (csr)->csr_pos[0];					\
	for (; check(ch); ch = csr->csr_pos[0]) {			\
		MOVE_CURSOR(csr, 1);					\
	}								\
} while (0)

static	int
skip_space(struct cursor *csr)
{
	char	ch;

	for (;;) {
		if (csr->csr_pos >= csr->csr_end) {
			return	(0);
		}
		/* depends on the padding ')' and '"' to stop */
		SKIP_WHILE(ch, csr, ISSPACE);
		if (csr->csr_pos >= csr->csr_end) {
			return	(0);
		}
		if (ch == '\n') {
			csr->csr_off = 1;
			csr->csr_line++;
			csr->csr_pos++;
			continue;
		}
		if (ch == ';') {
			/* comments */
			MOVE_CURSOR(csr, 1);
			SKIP_WHILE(ch, csr, !ISNEWLINE);
			continue;
		}
		return	(1);
	}

	/* not reached */
	return	(0);
}

static	dobj_ptr_t
alloc_dbg_info(struct memenv *env, uint32_t line, uint32_t off)
{
	dobj_ptr_t	dbg, objs[2];

	objs[0] = alloc_int_dobj(env, line);
	objs[1] = alloc_int_dobj(env, off);
	dbg = alloc_list_dobj(env, objs, 2, 0);

	return	(dbg);
}

static	dobj_ptr_t
alloc_error_info(struct memenv *env, uint32_t line,
		uint32_t off, dobj_ptr_t dbg, const char *fmt, ...)
{
	char		buf[64];
	dobj_ptr_t	err, objs[2];
	va_list		ap;
	int		len;

	va_start(ap, fmt);
	len = vsnprintf(buf, sizeof(buf), fmt, ap);
	va_end(ap);
	if (len > sizeof(buf)) {
		len = sizeof(buf);
	}
	if (dbg == DOBJ_NULL) {
		dbg = alloc_dbg_info(env, line, off);
	}
	objs[0] = dbg;
	objs[1] = alloc_string_dobj(env, buf, len);
	err = alloc_list_dobj(env, objs, 2, 0);

	return	(err);
}

#define	ID_INITIAL	"~!$%^&*/:<=>?_"
#define	DELIMITER	"\t\n\r ()\";"
#define	TOKEN_END_CHAR(ch)	\
	(memchr(DELIMITER, ch, sizeof(DELIMITER) - 1) != NULL)
#define	IDTK_INITIAL_CHAR(ch)	\
	(memchr(ID_INITIAL, ch, sizeof(ID_INITIAL) - 1) != NULL)

#define	TKOBJ_PBEGIN	DOBJ_INTERNAL_ENCODE(1)
#define	TKOBJ_VBEGIN	DOBJ_INTERNAL_ENCODE(2)
#define	TKOBJ_PVEND	DOBJ_INTERNAL_ENCODE(3)
#define	TKOBJ_DOT	DOBJ_INTERNAL_ENCODE(4)

struct	read_obj_arg {
	dobj_ptr_t	errinfo;
	struct	cursor	csr;
	struct	memenv*	env;
};

static	dobj_ptr_t
read_id_token(struct read_obj_arg *args)
{
	const	char	*from;
	struct	cursor	*csr;
	dobj_ptr_t	tk;
	char	ch;

	csr = &args->csr;
	from = csr->csr_pos;
	for (ch = csr->csr_pos[0]; ((ch >= 'a') && (ch <= 'z')) ||
			((ch >= 'A') && (ch <= 'Z')) ||
			((ch >= '0') && (ch <= '9')) ||
			IDTK_INITIAL_CHAR(ch) ||
			(ch == '+') || (ch == '-') ||
			(ch == '.') || (ch == '@'); ch = csr->csr_pos[0]) {
		MOVE_CURSOR(csr, 1);
	}
	if (!TOKEN_END_CHAR(ch)) {
		args->errinfo = alloc_error_info(args->env, csr->csr_line,
				csr->csr_off, DOBJ_NULL,
				"invalid character:%c in an identifier", ch);
	}
	tk = alloc_symbol_dobj(args->env, from, csr->csr_pos - from);

	return	(tk);
}

static	dobj_ptr_t
read_num_token(struct read_obj_arg *args, int base, int neg)
{
	char	digits[64];
	struct	cursor	*csr;
	intptr_t	val;
	dobj_ptr_t	tk;
	int	idx, db;
	char	ch;

	csr = &args->csr;
	if (base != 10) {
		int	shift, v0;
		if (base == 2) {
			shift = 1;
		} else if (base == 8) {
			shift = 3;
		} else {
			shift = 4;
		}
		for (val = 0, ch = csr->csr_pos[0];
				csr->csr_pos < csr->csr_end;
				ch = csr->csr_pos[0]) {
			MOVE_CURSOR(csr, 1);
			if ((ch >= '0') && (ch <= '9')) {
				v0 = ch - '0';
				if (v0 >= base) {
					args->errinfo =
						alloc_error_info(args->env,
								csr->csr_line,
								csr->csr_off,
								DOBJ_NULL,
								"number too "
								"large, %c for"
								" base %d", ch,
								base);
					return	(DOBJ_NULL);
				}
				val = (val << shift) + v0;
			} else if ((base == 16) && (ch >= 'a') && (ch <= 'f')) {
				v0 = ch - 'a';
				val = (val << 4) + v0;
			} else if ((base == 16) && (ch >= 'A') && (ch <= 'F')) {
				v0 = ch - 'A';
				val = (val << 4) + v0;
			} else if (ch == '#') {
				val = (val << shift) + (base >> 1);
			} else if (!TOKEN_END_CHAR(ch)) {
				args->errinfo = alloc_error_info(args->env,
						csr->csr_line, csr->csr_off,
						DOBJ_NULL,
						"invalid character '%c' in "
						"a number", ch);
				return	(DOBJ_NULL);
			} else {
				break;
			}
		}
		if (neg == 1) {
			val = 0 - val;
		}
		tk = alloc_int_dobj(args->env, val);

		return	(tk);
	}
	idx = 0;
	db = 0;
	if (neg == 1) {
		digits[idx++] = '-';
	}
	while (csr->csr_pos[0] == '0') {
		MOVE_CURSOR(csr, 1);
	}
	if (csr->csr_pos >= csr->csr_end) {
		tk = alloc_int_dobj(args->env, 0);
		return	(tk);
	}
	while ((idx < (sizeof(digits)/sizeof(digits[0]))) &&
			(csr->csr_pos < csr->csr_end)) {
		if (((ch = csr->csr_pos[0]) >= '0') && (ch <= '9')) {
			digits[idx++] = ch;
		} else if (ch == '#') {
			digits[idx++] = '5';
			db = 1;
		} else if ((ch == '.') || (ch == 'e') || (ch == 'E')) {
			digits[idx++] = ch;
			db = 1;
		} else if (!TOKEN_END_CHAR(ch)) {
			args->errinfo = alloc_error_info(args->env,
					csr->csr_line, csr->csr_off, DOBJ_NULL,
					"invalid character '%c' in a number",
					ch);
			return	(DOBJ_NULL);
		} else {
			break;
		}
		MOVE_CURSOR(csr, 1);
	}
	digits[idx] = '\0';
	if (db != 0) {
		double	n;
		n = strtod(digits, NULL);
		tk = alloc_double_dobj(args->env, n);
	} else {
		val = strtol(digits, NULL, 10);
		tk = alloc_int_dobj(args->env, val);
	}

	return	(tk);
}

static	int
analyze_num_prefix(char ch, int *base, int *exact)
{
	int	err;

	if (((ch == 'i') || (ch == 'e') ||
				(ch == 'I') || (ch == 'E')) &&
			(*exact != -1)) {
		return	(-1);
	} else if (*base != -1) {
		return	(-1);
	}
	err = 0;
	switch (ch) {
	case	'i':
	case	'I':
		*exact = 0;
		break;

	case	'E':
	case	'e':
		*exact = 1;
		break;

	case	'b':
	case	'B':
		*base = 2;
		break;

	case	'o':
	case	'O':
		*base = 8;
		break;

	case	'd':
	case	'D':
		*base = 10;
		break;

	case	'x':
	case	'X':
		*base = 16;
		break;

	default:
		err = -1;
		break;
	}

	return	(err);
}

static	dobj_ptr_t
read_prefixed_num(struct read_obj_arg *args, int neg)
{
	struct	cursor	*csr;
	dobj_ptr_t	n;
	int	base, exact;
	char	ch;

	base = -1;
	exact = -1;
	csr = &args->csr;
	/* skip the first '#' */
	MOVE_CURSOR(csr, 1);
	ch = csr->csr_pos[0];
	if (analyze_num_prefix(ch, &base, &exact) < 0) {
		args->errinfo = alloc_error_info(args->env,
				csr->csr_line, csr->csr_off, DOBJ_NULL,
				"invalid number prefix:'%c'", ch);
		return	(DOBJ_NULL);
	}
	MOVE_CURSOR(csr, 1);
	if (csr->csr_pos[0] == '#') {
		MOVE_CURSOR(csr, 1);
		ch = csr->csr_pos[0];
		if (analyze_num_prefix(ch, &base, &exact) < 0) {
			args->errinfo = alloc_error_info(args->env,
					csr->csr_line, csr->csr_off, DOBJ_NULL,
					"second invalid number prefix:'%c'",
					ch);
			return	(DOBJ_NULL);
		}
		MOVE_CURSOR(csr, 1);
	}
	if (base == -1) {
		base = 10;
	}
	n = read_num_token(args, base, neg);
	if ((exact == 1) && (DOBJ_TYPE(n) != DOBJT_INT)) {
		args->errinfo = alloc_error_info(args->env,
				csr->csr_line, csr->csr_off, DOBJ_NULL,
				"inexact number with exact prefix");
		return	(DOBJ_NULL);
	}

	return	(n);
}

static	dobj_ptr_t
read_signed_num(struct read_obj_arg *args)
{
	struct	cursor	*csr;
	dobj_ptr_t	n;
	int	neg;

	csr = &args->csr;
	if (csr->csr_pos[0] == '-') {
		neg = 1;
	} else {
		neg = 0;
	}
	MOVE_CURSOR(csr, 1);
	if (csr->csr_pos[0] == '#') {
		n = read_prefixed_num(args, neg);
	} else {
		n = read_num_token(args, 10, neg);
	}

	return	(n);
}

static	dobj_ptr_t
read_char_token(struct read_obj_arg *args)
{
	struct	cursor*	csr;
	dobj_ptr_t	chobj;
	char	ch;

	csr = &args->csr;
	MOVE_CURSOR(csr, 2);
	if (csr->csr_pos >= csr->csr_end) {
		args->errinfo = alloc_error_info(args->env,
				csr->csr_line, csr->csr_off, DOBJ_NULL,
				"unexpected end of input");
		return	(DOBJ_NULL);
	}
	ch = csr->csr_pos[0];
	if (((csr->csr_pos + 1) >= csr->csr_end) ||
	    TOKEN_END_CHAR(csr->csr_pos[1])) {
		MOVE_CURSOR(csr, 1);
		chobj = alloc_char_dobj(args->env, ch);
	} else {
		const	char	*from;
		uint32_t	l, o;
		int	len;

		l = csr->csr_line;
		o = csr->csr_off;
		from = csr->csr_pos;
		for (; ((ch >= 'a') && (ch <= 'z')) ||
			((ch >= 'A') && (ch <= 'Z')); ch = csr->csr_pos[0]) {
			MOVE_CURSOR(csr, 1);
		}
		if (!TOKEN_END_CHAR(ch)) {
			args->errinfo = alloc_error_info(args->env, l, o,
					DOBJ_NULL, "invalid character name");
			return	(DOBJ_NULL);
		}
		len = csr->csr_pos - from;
		if ((len == (sizeof("space") - 1)) &&
		    (strncasecmp(from, "space", len) == 0)) {
			chobj = alloc_char_dobj(args->env, ' ');
		} else if ((len == (sizeof("newline") - 1)) &&
		    (strncasecmp(from, "newline", len) == 0)) {
			chobj = alloc_char_dobj(args->env, '\n');
		} else {
			args->errinfo = alloc_error_info(args->env, l, o,
					DOBJ_NULL,
					"unknown character name:\"%.*s\"",
					len, from);
			chobj = DOBJ_NULL;
		}
	}

	return	(chobj);
}

static	dobj_ptr_t
read_string_token(struct read_obj_arg *args)
{
	struct	cursor	*csr;
	char	*buf, *sptr;
	const	char *ptr;
	dobj_ptr_t	sobj;
	int	len;
	char	ch;

	csr = &args->csr;
	for (ptr = csr->csr_pos + 1, len = 0;
			(ch = ptr[0]) != '"'; ptr++, len++) {
		if (ch == '\\') {
			ptr++;
		}
	}
	buf = malloc(len);
	if (buf == NULL) {
		args->errinfo = alloc_error_info(args->env,
				csr->csr_line, csr->csr_off, DOBJ_NULL,
				"can not allocate memory to parse string");
		return	(DOBJ_NULL);
	}
	for (ptr = csr->csr_pos + 1, sptr = buf; (ch = ptr[0]) != '"'; ptr++) {
		if (ch == '\\') {
			ch = ptr[1];
			ptr++;
			switch (ch) {
			case	'n':
				*sptr++ = '\n';
				break;

			case	'r':
				*sptr++ = '\r';
				break;

			case	't':
				*sptr++ = '\t';
				break;

			case	'"':
				*sptr++ = '"';
				break;

			case	'\\':
				*sptr++ = '\\';
				break;

			default:
				*sptr++ = ch;
				break;
			}
		} else {
			*sptr++ = ch;
		}
	}

	sobj = alloc_string_dobj(args->env, buf, len);
	free(buf);

	return	(sobj);
}

static	int
lex_init(struct read_obj_arg *ctx, struct memenv *env, dobj_ptr_t strobj)
{
	struct	dobj_string	*sobj;

	if (DOBJ_TYPE(strobj) != DOBJT_STRING) {
		ctx->errinfo = alloc_error_info(env,
				0, 0, DOBJ_NULL, "object is not a string");
		return	(-1);
	}
	ctx->env = env;
	ctx->errinfo = DOBJ_FALSE;
	sobj = MENV_GET_OBJ(env, DOBJ_PTR(strobj));
	sobj->dobj_str_data[sobj->dobj_str_length + 1] = '\n';
	sobj->dobj_str_data[sobj->dobj_str_length + 2] = '"';
	sobj->dobj_str_data[sobj->dobj_str_length + 3] = ')';
	ctx->csr.csr_off = 1;
	ctx->csr.csr_line = 1;
	ctx->csr.csr_pos = (char*)sobj->dobj_str_data;
	ctx->csr.csr_end = ctx->csr.csr_pos + sobj->dobj_str_length;

	return	(0);
}

static	int
get_next_token(struct read_obj_arg *args, dobj_ptr_t *tkp, dobj_ptr_t *dbg)
{
	struct	cursor	*csr;
	dobj_ptr_t	tk;
	uint32_t	curline, curoff;
	char	ch;

	csr = &args->csr;
	if (skip_space(csr) != 1) {
		return	(0);
	}
	curline = csr->csr_line;
	curoff = csr->csr_off;
	tk = DOBJ_NULL;			/* avoid warnings */
	ch = csr->csr_pos[0];
	if (((ch >= 'a') && (ch <= 'z')) ||
	    ((ch >= 'A') && (ch <= 'Z')) ||
	    IDTK_INITIAL_CHAR(ch)) {
		tk = read_id_token(args);
	} else if ((ch >= '0') && (ch <= '9')) {
		tk = read_num_token(args, 10, 0);
	} else if ((ch == '+') || (ch == '-')) {
		if (((csr->csr_pos + 1) >= csr->csr_end) ||
		    TOKEN_END_CHAR(csr->csr_pos[1])) {
			/* id */
			tk = alloc_symbol_dobj(args->env, csr->csr_pos, 1);
			MOVE_CURSOR(csr, 1);
		} else {
			tk = read_signed_num(args);
		}
	} else if (ch == '#') {
		if ((csr->csr_pos[1] == 't') ||
		    (csr->csr_pos[1] == 'f')) {
			if (((csr->csr_pos + 2) >= csr->csr_end) ||
			    TOKEN_END_CHAR(csr->csr_pos[2])) {
				tk = alloc_bool_dobj(args->env,
						csr->csr_pos[1] != 'f');
				MOVE_CURSOR(csr, 2);
			} else {
				/* error */
				args->errinfo = alloc_error_info(args->env,
						curline, curoff, DOBJ_NULL,
						"expect delimiters following "
						"#t/#f");
			}
		} else if (csr->csr_pos[1] == '\\') {
			tk = read_char_token(args);
		} else if (csr->csr_pos[1] == '(') {
			tk = TKOBJ_VBEGIN;
			MOVE_CURSOR(csr, 2);
		} else {
			tk = read_prefixed_num(args, 0);
		}
	} else {
		switch (ch) {
		case	'(':
			tk = TKOBJ_PBEGIN;
			MOVE_CURSOR(csr, 1);
			break;
		case	')':
			tk = TKOBJ_PVEND;
			MOVE_CURSOR(csr, 1);
			break;
		case	'.':
			tk = TKOBJ_DOT;
			MOVE_CURSOR(csr, 1);
			break;
		case	'\'':
			tk = alloc_symbol_dobj(args->env,
					"quote", sizeof("quote") - 1);
			MOVE_CURSOR(csr, 1);
			break;
		case	'`':
			tk = alloc_symbol_dobj(args->env,
					"quasiquote", sizeof("quasiquote") - 1);
			MOVE_CURSOR(csr, 1);
			break;
		case	',':
			if (csr->csr_pos[1] != '@') {
				tk = alloc_symbol_dobj(args->env, "unquote",
						sizeof("unquote") - 1);
				MOVE_CURSOR(csr, 1);
				break;
			}
			tk = alloc_symbol_dobj(args->env,
					"unquote-splicing",
					sizeof("unquote-splicing") - 1);
			MOVE_CURSOR(csr, 2);
			break;
		case	'"':
			tk = read_string_token(args);
			break;
		default:
			args->errinfo = alloc_error_info(args->env,
					curline, curoff, DOBJ_NULL,
					"invalid token:%c", ch);
			break;
		}
	}
	if (args->errinfo != DOBJ_FALSE) {
		return	(-1);
	} else {
		*dbg = alloc_dbg_info(args->env, curline, curoff);
		*tkp = tk;
	}

	return	(1);
}

int
read_dobj(struct memenv *env, dobj_ptr_t strobj, dobj_ptr_t *res)
{
	struct	read_obj_arg	args;
	struct	vector	tks, dbgs;
	dobj_ptr_t	curtk, curdbg, objs[3], *btk, *bd;
	int	i, n, dot, err;

	INIT_VECTOR(&tks);
	INIT_VECTOR(&dbgs);
	objs[1] = objs[2] = DOBJ_FALSE;
	if (lex_init(&args, env, strobj) < 0) {
		goto	fini;
	}
	while ((err = get_next_token(&args, &curtk, &curdbg)) == 1) {
		if (curtk != TKOBJ_PVEND) {
			if ((vector_append_dobj(&tks, curtk) < 0) ||
			    (vector_append_dobj(&dbgs, curdbg) < 0)) {
				goto	fini;
			}
			continue;
		}
		dot = -1;
		n = tks.vect_cur / sizeof(curtk) - 1;
		btk = (void*)tks.vect_base;
		bd = (void*)dbgs.vect_base;
		for (i = n; (i >= 0) &&
				(btk[i] != TKOBJ_PBEGIN) &&
				(btk[i] != TKOBJ_VBEGIN); i--) {
			if (btk[i] == TKOBJ_DOT) {
				if (dot != -1) {
					args.errinfo = alloc_error_info(env,
							0, 0, curdbg,
							"too many dots");
					goto	fini;
				}
				dot = i;
			}
		}
		if (i < 0) {
			args.errinfo = alloc_error_info(env, 0, 0,
					curdbg, "')' is not matched");
			goto	fini;
		}
		if (btk[i] == TKOBJ_PBEGIN) {
			if (dot != -1) {
				if (((dot + 1) != n) || ((i + 1) >= dot)) {
					args.errinfo = alloc_error_info(env,
							0, 0, curdbg,
							"invalid dot position");
					goto	fini;
				}
				btk[dot] = btk[n];
				bd[dot] = bd[n];
				n--;
				dot = 0;
			}
			dot++; /* -1/0 ==> 0/1 */
			curtk = alloc_list_dobj(env, &btk[i + 1], n - i, dot);
			curdbg = alloc_list_dobj(env, &bd[i + 1], n - i, dot);
		} else if (dot != -1) {
			args.errinfo = alloc_error_info(env, 0, 0, curdbg,
					"dot is not allowed in a vector");
			goto	fini;
		} else {
			curtk = alloc_vector_dobj(env, &btk[i + 1], n - i);
			curdbg = alloc_vector_dobj(env, &bd[i + 1], n - i);
		}
		btk[i] = curtk;
		bd[i] = curdbg;
		tks.vect_cur = (i + 1) * sizeof(curtk);
		dbgs.vect_cur = tks.vect_cur;
	}
	if (err < 0) {
		goto	fini;
	}
	n = tks.vect_cur / sizeof(curtk);
	btk = (void*)tks.vect_base;
	bd = (void*)dbgs.vect_base;
	for (i = 0; i < n; i++) {
		if (DOBJ_INTERNAL(btk[i])) {
			const	char	*msg;

			switch (btk[i]) {
			case	TKOBJ_PBEGIN:
				msg = "'(' is not closed";
				break;
			case	TKOBJ_VBEGIN:
				msg = "vector is not closed";
				break;
			case	TKOBJ_DOT:
				msg = "a dot not in a pair";
				break;
			default:
				msg = "internal error!";
				break;
			}
			args.errinfo = alloc_error_info(env, 0, 0, bd[i], msg);
			goto	fini;
		}
	}
	objs[1] = alloc_list_dobj(env, btk, n, 0);
	objs[2] = alloc_list_dobj(env, bd, n, 0);
fini:
	FINI_VECTOR(&dbgs);
	FINI_VECTOR(&tks);
	objs[0] = args.errinfo;
	*res = alloc_list_dobj(env, objs, 3, 0);

	return	(0);
}

